home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 4 / BBS in a Box - Macintosh - Volume IV (January 1992) (BBS in a Box).iso / Files / Prog / U-Z / WORDMIXER.cpt / WORDMIXER
Encoding:
Text File  |  1988-12-07  |  15.4 KB  |  704 lines  |  [TEXT/MSBB]
  1. READ last.option%
  2. DIM menu.label$(last.option%)
  3. FOR j%=0 TO last.option%
  4. READ menu.label$(j%)
  5. NEXT  j%
  6. DATA 9,Puzzle
  7. DATA Change grid shape,Change grid size,Change word list
  8. DATA Make puzzle,Print puzzle,Print solution coordinates
  9. DATA Save grid,Save word list,Quit
  10. DIM cursor%(33)
  11. FOR j%=0 TO 33
  12. READ cursor%(j%)
  13. NEXT j%
  14. DATA 0,0,0
  15. DATA &H0808,&H0410,&H0220,&H0140,&H0080
  16. DATA &H0140,&H0220,&H0410,&H0808
  17. DATA 0,0,0,0
  18. DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  19. DATA 8,9
  20. LET w1.x%=.1*72    :REM window #1 left side
  21. LET w1.y%=.35*72    :REM top
  22. LET w1.w%=2.5*72    :REM width
  23. LET w1.l%=3.5*72    :REM length
  24. LET w1.x1%=w1.w%+w1.x%    :REM right side
  25. LET w1.y1%=w1.l%+w1.y%    :REM bottom
  26. LET w2.x%=2.7*72    :REM window #2 left side
  27. LET w2.y%=.35*72    :REM and so forth...
  28. LET w2.w%=4.3*72
  29. LET w2.l%=4.3*72
  30. LET w2.x2%=w2.w%+w2.x%
  31. LET w2.y2%=w2.l%+w2.y%
  32. LET border%=6
  33. LET m2.w%=w2.w%-border%*2
  34. LET m2.l%=w2.l%-border%*2
  35. LET l.side%=3
  36. LET l.space%=4
  37. LET l.tot%=l.side%+l.space%
  38. LET max.c%=(m2.w%+l.side%)\l.tot%
  39. LET max.r%=(m2.l%+l.side%)\l.tot%
  40. LET max.wds%=100: REM arbitrary upper limit
  41. LET nu$="": REM no spaces inside quotes
  42. LET hole$=" ": REM one space inside quotes
  43. LET ltr.cell$="."
  44. LET no.more$="/"
  45. LET not.used%=-1
  46. LET yes%=-1
  47. LET no%=0
  48. LET ZONE%=2
  49. READ max.dir%
  50. DIM dev$(3),ri%(max.dir%),ci%(max.dir%)
  51. LET dev$(1)="SCRN:"
  52. LET dev$(2)="LPT1:DIRECT"
  53. LET dev$(3)="CLIP:TEXT"
  54. FOR j%=1 TO max.dir%
  55. READ ri%(j%),ci%(j%)
  56. NEXT j%
  57. DATA 8
  58. DATA 0,1, 1,1, 1,0, 1,-1, 0,-1, -1,-1, -1,0, -1,1
  59. RANDOMIZE TIMER
  60. LET wd.count%=0
  61. LET last.r%=0
  62. LET last.c%=0
  63. LET g.size%=0
  64. DIM wd$(wd.count%),wu%(wd.count%),wd.seq%(wd.count%)
  65. DIM grid$(last.r%,last.c%),cell.seq%(g.size%)
  66. LET m.state%=0
  67. FOR j%=0 TO last.option%
  68. MENU 6,j%,m.state%,menu.label$(j%)
  69. NEXT j%
  70. MENU 6,3,1    'enable change-word-list option
  71. MENU 6,2,1    'enable change-size option
  72. MENU 6,9,1    'enable quit option
  73. WINDOW 1,,(w1.x%,w1.y%)-(w1.x1%,w1.y1%),3
  74. GOSUB dialogue.vocab
  75. GOSUB dialogue.size
  76. MENU 6,4,1   'enable make-puzzle option
  77. GOSUB make.pzl
  78. IF c.flag%=no% THEN GOSUB prt.pzl
  79. get.selection:
  80. MENU 6,0,1
  81. WHILE MENU(0)<>6
  82. WEND
  83. MENU 6,0,0
  84. LET selection%=MENU(1)
  85. IF selection%=0 THEN get.selection
  86. WINDOW CLOSE 2
  87. IF selection%=last.option% THEN END
  88. IF selection%>3 THEN skip.gs
  89. ON selection% GOSUB dialogue.shape,dialogue.size,dialogue.vocab
  90. GOTO get.selection
  91. skip.gs:
  92. ON selection%-3 GOSUB make.pzl,prt.pzl,prt.sol,save.t,save.vocab
  93. GOTO get.selection
  94. dialogue.vocab:
  95. WINDOW 1
  96. CLS
  97. PRINT "SET UP WORD LIST"
  98. BUTTON 1,1,"Key in new words",(2,32)-(w1.x1%-6,48),3
  99. BUTTON 2,1,"Load new words (disk)",(2,64)-(w1.x1%-6,80),3
  100. BUTTON 3,0,"Edit word list",(2,96)-(w1.x1%-6,112),3
  101. IF wd.count%>0 THEN BUTTON 3,1
  102. WHILE DIALOG(0)<>1
  103. WEND
  104. LET btn%=DIALOG(1)
  105. BUTTON CLOSE 1
  106. BUTTON CLOSE 2
  107. BUTTON CLOSE 3
  108. MENU 6,5,0    'disable print puzzle option
  109. MENU 6,6,0    'disable print solution option
  110. ON btn% GOTO key.vocab,disk.vocab,edit.vocab
  111. key.vocab:
  112. CLS
  113. PRINT "KEY IN NEW WORDS"
  114. PRINT
  115. PRINT "How many words?"
  116. PRINT TAB(3);"( 1 -";max.wds%;")";
  117. EDIT FIELD 1,"",(120,48)-(156,63)
  118. key.loop:
  119. LET event%=DIALOG(0)
  120. WHILE event%=0
  121. LET event%=DIALOG(0)
  122. WEND
  123. IF event%<>2 AND event%<>6 THEN key.loop:
  124. LET entry=VAL(EDIT$(1))
  125. IF entry<>INT(entry) THEN key.err
  126. IF entry <&H8000 OR entry>&H7FFF THEN key.err
  127. LET wd.count%=entry
  128. IF wd.count%<1 OR wd.count%>max.wds% THEN key.err
  129. ERASE wd$,wu%,wd.seq%
  130. DIM wd$(wd.count%),wu%(wd.count%),wd.seq%(wd.count%)
  131. EDIT FIELD CLOSE 1
  132. GOTO edit.vocab
  133. key.err:
  134. BEEP
  135. GOTO key.vocab
  136. disk.vocab:
  137. CLS
  138. PRINT "LOAD NEW WORDS (DISK)"
  139. LET vocab.file$=FILES$(1,"TEXT")    :REM dialog box to select a file
  140. IF vocab.file$=nu$ THEN dialogue.vocab    :REM if cancelled try again
  141. LET wd.count%=0
  142. OPEN vocab.file$ FOR INPUT AS 1
  143. WHILE NOT EOF(1)
  144. LINE INPUT#1,w$
  145. LET wd.count%=wd.count%+1
  146. WEND
  147. CLOSE 1
  148. ERASE wd$,wu%,wd.seq%
  149. DIM wd$(wd.count%),wu%(wd.count%),wd.seq%(wd.count%)
  150. OPEN vocab.file$ FOR INPUT AS 1
  151. FOR j%=1 TO wd.count%
  152. LINE INPUT#1,w$
  153. LET wd$(j%)=UCASE$(w$)
  154. NEXT j%
  155. CLOSE 1
  156. edit.vocab:
  157. CLS
  158. PRINT "EDIT WORD LIST"
  159. PRINT
  160. PRINT "Vocabulary size=";wd.count%
  161. BUTTON 1,1,"BACK",(52,144)-(122,159)
  162. BUTTON 2,1,"FORWARD",(52,176)-(122,191)
  163. BUTTON 3,1,"OK",(52,208)-(122,223)
  164. LET wd.ptr%=1
  165. edit.loop:
  166. LOCATE 5,1
  167. PRINT "Enter word #";wd.ptr%;":"
  168. EDIT FIELD 1,wd$(wd.ptr%),(6,96)-(w1.w%-6,111)
  169. edit.here:
  170. LET event%=DIALOG(0)
  171. WHILE event%=0
  172. LET event%=DIALOG(0)
  173. WEND
  174. IF event%=1 THEN edit.btn
  175. IF event%=2 THEN edit.here
  176. IF event%=6 THEN edit.fld
  177. GOTO edit.loop
  178. edit.fld:
  179. LET wd$(wd.ptr%)=UCASE$(EDIT$(1))
  180. LET wd.ptr%=wd.ptr% MOD wd.count%+1
  181. GOTO edit.loop
  182. edit.btn:
  183. LET wd$(wd.ptr%)=UCASE$(EDIT$(1))
  184. ON DIALOG(1) GOTO edit.back,edit.fwd,done.vocab
  185. edit.back:
  186. IF wd.ptr%>1 THEN LET wd.ptr%=wd.ptr%-1 ELSE LET wd.ptr%=wd.count%
  187. GOTO edit.loop
  188. edit.fwd:
  189. LET wd.ptr%=wd.ptr% MOD wd.count%+1
  190. GOTO edit.loop
  191. done.vocab:
  192. WINDOW CLOSE 1
  193. MENU 6,8,1    'enable save-word-list option
  194. RETURN
  195. dialogue.size:
  196. WINDOW 1
  197. CLS: ON ERROR GOTO 0
  198. PRINT "SET PUZZLE SIZE"
  199. BUTTON 1,1,"Key in new grid size",(2,32)-(w1.x1%-6,48),3
  200. BUTTON 2,1,"Load new grid (disk)",(2,64)-(w1.x1%-6,80),3
  201. BUTTON 3,0,"Edit current grid size",(2,96)-(w1.x1%-6,112),3
  202. IF g.size%>0 THEN BUTTON 3,1
  203. WHILE DIALOG(0)<>1
  204. WEND
  205. LET btn%=DIALOG(1)
  206. BUTTON CLOSE 1
  207. BUTTON CLOSE 2
  208. BUTTON CLOSE 3
  209. MENU 6,5,0    'disable print puzzle option
  210. MENU 6,6,0    'disable print solution option
  211. ON btn% GOTO key.grid,disk.grid,dialogue.shape
  212. key.grid:
  213. CLS
  214. PRINT "KEY IN NEW GRID SIZE"
  215. PRINT
  216. PRINT "How many rows?"
  217. PRINT TAB(3); "( 1-";max.r%;")"
  218. PRINT
  219. PRINT "How many columns?"
  220. PRINT TAB(3); "( 1-";max.c%;")";
  221. EDIT FIELD 2,"",(120,96)-(156,111)
  222. EDIT FIELD 1,"",(120,48)-(156,63)
  223. BUTTON 1,0,"OK",(52,186)-(122,213)
  224. LET fld%=1
  225. LET nxt.fld%=1
  226. LET r.ok%=no%
  227. LET c.ok%=no%
  228. grid.loop:
  229. BUTTON 1,c.ok%*r.ok%
  230. LET event%=DIALOG(0)
  231. IF event%=1 THEN GOTO check.fld
  232. IF event%=2 THEN LET nxt.fld%=DIALOG(2): GOTO check.fld
  233. IF event%=6 THEN LET nxt.fld%=(fld% MOD 2)+1: GOTO check.fld
  234. GOTO grid.loop
  235. check.fld:
  236. LET entry=VAL(EDIT$(fld%))
  237. IF entry<>INT(entry) THEN fld.err
  238. IF entry<-32768! OR entry>32767 THEN fld.err
  239. ON fld% GOTO check.row,check.col
  240. check.row:
  241. LET last.r%=entry
  242. LET r.ok%=(last.r%>=1 AND last.r%<=max.r%)
  243. IF r.ok%=no% THEN fld.err
  244. GOTO fld.ok
  245. check.col:
  246. LET last.c%=entry
  247. LET c.ok%=(last.c%>=1 AND last.c%<=max.c%)
  248. IF c.ok%=no% THEN fld.err
  249. fld.ok:
  250. IF event%=1 THEN grid.ok
  251. LET fld%=nxt.fld%
  252. EDIT FIELD fld%
  253. GOTO grid.loop
  254. fld.err:
  255. BEEP
  256. EDIT FIELD fld%
  257. GOTO grid.loop
  258. grid.ok:
  259. EDIT FIELD CLOSE 1
  260. EDIT FIELD CLOSE 2
  261. BUTTON CLOSE 1
  262. GOSUB grid.arrays
  263. MENU 6,1,1    'enable change-shape option
  264. MENU 6,7,1    'enable save-shape option
  265. GOTO dialogue.shape
  266. disk.grid:
  267. CLS
  268. PRINT "LOAD NEW GRID (DISK)"
  269. LET grid.file$=FILES$(1,"TEXT")
  270. IF grid.file$=nu$ THEN dialogue.size
  271. ON ERROR GOTO grid.file.err
  272. OPEN grid.file$ FOR INPUT AS 1
  273. INPUT#1,last.r%,last.c%
  274. GOSUB grid.arrays
  275. FOR r%=1 TO last.r%
  276. FOR c%=1 TO last.c%
  277. INPUT#1,grid$(r%,c%)
  278. NEXT c%,r%
  279. CLOSE 1
  280. ON ERROR GOTO 0
  281. WINDOW CLOSE 1
  282. MENU 6,1,1    'enable change-shape option
  283. MENU 6,7,1    'enable save-shape option
  284. GOTO dialogue.shape
  285. grid.file.err:
  286. CLOSE 1
  287. LET errcode%=ERR
  288. IF errcode%<>6 AND errcode%<>13 AND errcode%<>62 THEN unknown.err
  289. BEEP
  290. PRINT "Invalid data in"
  291. PRINT grid.file$
  292. BUTTON 1,1,"OK",(52,220)-(102,24),1
  293. WHILE DIALOG(0)<>1
  294. WEND
  295. RESUME dialogue.size
  296. unknown.err:
  297. ON ERROR GOTO 0
  298. grid.arrays:
  299. LET g.size%=last.r%*last.c%
  300. ERASE grid$,cell.seq%
  301. DIM grid$(last.r%,last.c%),cell.seq%(g.size%)
  302. RETURN
  303. make.pzl:
  304. WINDOW 1
  305. CLS
  306. PRINT "NEW PUZZLE STATUS"
  307. PRINT
  308. BUTTON 1,1,"CANCEL",(52,220)-(116,240),1
  309. LET c.flag%=no%
  310. DIALOG ON
  311. ON DIALOG GOSUB rq.cancel
  312. GOSUB erase.grid
  313. GOSUB sort.words
  314. IF c.flag%=yes% THEN cancel.pzl
  315. GOSUB shuffle
  316. IF c.flag%=yes% THEN cancel.pzl
  317. GOSUB auto.fill
  318. IF c.flag%=yes% THEN cancel.pzl
  319. PRINT "Print matrix solution (Y/N)"
  320. 1 solution$=INKEY$
  321. IF solution$="" THEN 1
  322. IF solution$="Y" THEN GOSUB prt.pzl
  323. IF solution$="y" THEN WINDOW CLOSE 1:GOSUB prt.pzl:solution$="Y"
  324. IF solution$ <> "Y" THEN BUTTON CLOSE 1
  325. IF solution$ <> "Y" THEN WINDOW 1
  326. IF solution$<> "Y" THEN X=15 ELSE X=19
  327. AGAIN:
  328. LOCATE X,1
  329. PRINT "Press any key to continue";
  330. IF INKEY$="" THEN AGAIN
  331. WINDOW CLOSE 2
  332. WINDOW 1
  333. GOSUB random.fill
  334. IF c.flag%=yes% THEN cancel.pzl
  335. DIALOG OFF
  336. BEEP
  337. LOCATE 15,1
  338. PRINT "Puzzle is ready"
  339. BUTTON 1,1,"OK",(54,200)-(104,220),1
  340. WHILE DIALOG(0)<>1
  341. WEND
  342. WINDOW CLOSE 1:TEXTFACE(0)
  343. MENU 6,5,1    'enable print-puzzle option
  344. MENU 6,6,1    'enable print-solution option
  345. RETURN
  346. cancel.pzl:
  347. DIALOG OFF
  348. WINDOW CLOSE 1
  349. RETURN
  350. rq.cancel:
  351. IF DIALOG(0)=1 THEN LET c.flag%=yes%
  352. RETURN
  353. dialogue.shape:
  354. LET aw%=last.c%*l.tot%-l.side%+2*border%
  355. LET al%=last.r%*l.tot%-l.side%+2*border%
  356. WINDOW 2,,(w2.x%,w2.y%)-(w2.x%+aw%,w2.y%+al%),3
  357. WINDOW 1
  358. MENU 6,5,0    'disable print puzzle option
  359. MENU 6,6,0    'disable print solution option
  360. CLS
  361. PRINT "EDIT PUZZLE SHAPE"
  362. PRINT
  363. PRINT "Cursor function:"
  364. BUTTON 1,0,"ERASE",(52,64)-(122,79),2
  365. BUTTON 2,0,"FILL",(52,96)-(122,111),2
  366. BUTTON 3,1,"OK",(52,208)-(122,235),1
  367. LET shape.done%=no%
  368. DIALOG ON
  369. ON DIALOG GOSUB shape.interrupt
  370. WINDOW OUTPUT 2
  371. LET color%=1
  372. FOR r%=1 TO last.r%
  373. FOR c%=1 TO last.c%
  374. IF shape.done%=yes% THEN LET r%=last.r%:LET c%=last.c%:GOTO skip
  375. IF grid$(r%,c%)<>hole$ THEN GOSUB set.reset
  376. skip:
  377. NEXT c%,r%
  378. LET color%=0
  379. WINDOW OUTPUT 1
  380. BUTTON 1,2
  381. BUTTON 2,1
  382. check.mouse:
  383. LET mouse.status%=ABS(MOUSE(0))
  384. WHILE mouse.status%<>1
  385. IF shape.done%=yes% THEN done
  386. LET mouse.status%=ABS(MOUSE(0))
  387. WEND
  388. LET mouse.x%=MOUSE(1)
  389. LET mouse.y%=MOUSE(2)
  390. LET c%=(mouse.x%-border%+l.tot%)\l.tot%
  391. LET r%=(mouse.y%-border%+l.tot%)\l.tot%
  392. IF c%<1 OR c%>last.c% OR r%<1 OR r%>last.r% THEN check.mouse
  393. IF color%=0 THEN LET grid$(r%,c%)=hole$ ELSE LET grid$(r%,c%)=ltr.cell$
  394. GOSUB set.reset
  395. GOTO check.mouse
  396. shape.interrupt:
  397. LET event%=DIALOG(0)
  398. IF event%=3 THEN change.windows
  399. IF event%<>1 THEN RETURN
  400. LET btn%=DIALOG(1)
  401. ON btn% GOTO set.color,set.color,request.end
  402. change.windows:
  403. LET rq.w%=DIALOG(3)
  404. WINDOW rq.w%
  405. IF rq.w%=1 THEN CALL INITCURSOR
  406. IF rq.w%=2 THEN CALL SETCURSOR(VARPTR(cursor%(0)))
  407. RETURN
  408. set.color:
  409. WINDOW OUTPUT 1
  410. BUTTON btn%,2
  411. BUTTON 3-btn%,1
  412. LET color%=btn%-1
  413. WINDOW OUTPUT 2
  414. RETURN
  415. request.end:
  416. LET shape.done%=yes%
  417. RETURN
  418. set.reset:
  419. LET char.x%=(c%-1)*l.tot%+border%
  420. LET char.y%=(r%-1)*l.tot%+border%
  421. LINE (char.x%,char.y%)-STEP (l.side%,l.side%),color%,bf
  422. RETURN
  423. done:
  424. CALL INITCURSOR
  425. DIALOG OFF
  426. WINDOW CLOSE 2
  427. WINDOW CLOSE 1
  428. RETURN
  429. erase.grid:
  430. PRINT "Erasing the puzzle grid..."
  431. FOR j%=1 TO last.r%
  432. FOR k%=1 TO last.c%
  433. IF grid$(j%,k%)<>hole$ THEN LET grid$(j%,k%)=ltr.cell$
  434. IF c.flag%=yes% THEN LET j%=last.r%: LET k%=last.c%
  435. NEXT k%,j%
  436. RETURN
  437. sort.words:
  438. PRINT "Sorting the words...":REM Sorts words by length of words for placement in puzzle
  439. FOR j%=1 TO wd.count%:REM does not alphabetize words
  440. LET wd.seq%(j%)=j%
  441. NEXT j%
  442. LET lw%=wd.count%
  443. bubble.sort:
  444. IF lw%=1 THEN sorted
  445. LET sort.ok%=yes%
  446. FOR j%=1 TO lw%-1
  447. LET l2%=LEN(wd$(wd.seq%(j%+1)))
  448. LET l1%=LEN(wd$(wd.seq%(j%)))
  449. IF l2%>l1% THEN SWAP wd.seq%(j%),wd.seq%(j%+1): sort.ok%=no%
  450. IF c.flag%=yes% THEN LET sort.ok%=yes%: LET lw%=1
  451. NEXT j%
  452. IF sort.ok%=yes% THEN sorted
  453. LET lw%=lw%-1
  454. GOTO bubble.sort
  455. sorted:
  456. FOR j%=1 TO wd.count%
  457. LET wu%(j%)=not.used%
  458. IF c.flag%=yes% THEN LET j%=wd.count%
  459. NEXT j%
  460. RETURN
  461. shuffle:
  462. PRINT "Shuffling the cells..."
  463. FOR j%=1 TO g.size%
  464. LET cell.seq%(j%)=0
  465. NEXT j%
  466. FOR j%=1 TO g.size%
  467. find.unused:
  468. LET g.ptr%=INT(RND*g.size%)+1
  469. IF cell.seq%(g.ptr%)<>0 THEN find.unused
  470. LET cell.seq%(g.ptr%)=j%
  471. IF c.flag%=yes% THEN LET j%=g.size%
  472. NEXT j%
  473. RETURN
  474. auto.fill:
  475. LOCATE 7,1
  476. PRINT "Filling in the puzzle..."
  477. PRINT "Pass #"
  478. PRINT "Words used ="
  479. PRINT "Cells checked="
  480. LET dir%=INT(RND*max.dir%)+1
  481. LET wds.left%=wd.count%
  482. LET pass.num%=1
  483. af.loop:
  484. LOCATE 8,7
  485. PRINT USING "#";pass.num%
  486. GOSUB next.pass
  487. PRINT
  488. IF pass.num%=2 OR wds.left%=0 OR c.flag%=yes% THEN af.done
  489. LET pass.num%=2
  490. GOTO af.loop
  491. af.done:
  492. RETURN
  493. next.pass:
  494. LET g.ptr%=1
  495. np.loop:
  496. GOSUB cell.check
  497. LOCATE 9,11
  498. PRINT USING "##";wd.count%-wds.left%
  499. LOCATE 10,13
  500. PRINT USING "###";g.ptr%
  501. IF wds.left%=0 OR g.ptr%=g.size% OR c.flag%=yes% THEN np.done
  502. LET g.ptr%=g.ptr%+1
  503. GOTO np.loop
  504. np.done:
  505. RETURN
  506. cell.check:
  507. LET wd.ptr%=1
  508. LET word.fit%=no%
  509. LET cell.num%=cell.seq%(g.ptr%)
  510. LET row%=(cell.num%-1)\last.c%+1
  511. LET col%=(cell.num%-1) MOD last.c%+1
  512. LET t$=grid$(row%,col%)
  513. IF pass.num%=1 THEN LET skip.it%=(t$=hole$)
  514. IF pass.num%=2 THEN LET skip.it%=(t$=hole$) OR (t$=ltr.cell$)
  515. IF skip.it%=yes% THEN cc.done
  516. cc.loop:
  517. GOSUB word.check
  518. IF word.fit%=yes% OR wd.ptr%=wds.left% OR c.flag%=yes% THEN cc.done
  519. LET wd.ptr%=wd.ptr%+1
  520. GOTO cc.loop
  521. cc.done:
  522. RETURN
  523. word.check:
  524. LET wd.num%=wd.seq%(wd.ptr%)
  525. LET try.wd$=wd$(wd.num%)
  526. LET wl%=LEN(try.wd$)
  527. LET dir.count%=1
  528. wc.loop:
  529. GOSUB dir.check
  530. IF word.fit%=yes% THEN LET dir%=dir% MOD max.dir%+1: GOTO wc.done
  531. IF dir.count%=max.dir% THEN wc.done
  532. LET dir.count%=dir.count%+1
  533. LET dir%=dir% MOD max.dir%+1
  534. GOTO wc.loop
  535. wc.done:
  536. RETURN
  537. dir.check:
  538. LET f.row%=row%+(wl%-1)*ri%(dir%)
  539. LET f.col%=col%+(wl%-1)*ci%(dir%)
  540. LET r.ok%=(f.row%>=1) AND (f.row%<=last.r%)
  541. LET c.ok%=(f.col%>=1) AND (f.col%<=last.c%)
  542. IF NOT (r.ok% AND c.ok%) THEN dc.done
  543. LET word.fit%=yes%
  544. LET pr%=row%
  545. LET pc%=col%
  546. FOR l%=1 TO wl%
  547. LET t$=grid$(pr%,pc%)
  548. LET word.fit%=(t$=ltr.cell$) OR (t$=MID$(try.wd$,l%,1))
  549. IF word.fit%=no% THEN LET l%=wl%: GOTO nxt
  550. LET pr%=pr%+ri%(dir%)
  551. LET pc%=pc%+ci%(dir%)
  552. nxt:
  553. NEXT l%
  554. IF word.fit%=no% THEN dc.done
  555. LET pr%=row%
  556. LET pc%=col%
  557. FOR l%=1 TO wl%
  558. LET grid$(pr%,pc%)=MID$(try.wd$,l%,1)
  559. LET pr%=pr%+ri%(dir%)
  560. LET pc%=pc%+ci%(dir%)
  561. NEXT l%
  562. IF wd.ptr%>wds.left% THEN cut.word
  563. FOR j%=wd.ptr% TO wds.left%-1
  564. LET wd.seq%(j%)=wd.seq%(j%+1)
  565. NEXT j%
  566. cut.word:
  567. LET wds.left%=wds.left%-1
  568. LET wu%(wd.num%)=(dir%-1)*g.size%+cell.num%-1
  569. dc.done:
  570. RETURN
  571. random.fill:
  572. LOCATE 12,1
  573. PRINT "Filling gaps....                              "
  574. FOR row%=1 TO last.r%
  575. FOR col%=1 TO last.c%
  576. IF grid$(row%,col%)<>ltr.cell$ THEN nxt.fill
  577. LET grid$(row%,col%)=CHR$(INT(RND*26)+65)
  578. nxt.fill:
  579. IF c.flag%=yes% THEN LET col%=last.c%: LET row%=last.r%
  580. NEXT col%,row%
  581. BUTTON CLOSE 1
  582. CLS
  583. FOR row%=1 TO last.r%
  584. FOR col%=1 TO last.c%
  585. PRINT grid$(row%,col%);
  586. NEXT col%
  587. PRINT
  588. NEXT row%
  589. TEXTFACE(1)
  590. RETURN
  591. save.t:
  592. WINDOW 1
  593. CLS
  594. PRINT "SAVE PUZZLE GRID"
  595. grid.file$=FILES$(0)
  596. IF grid.file$=nu$ THEN st.done
  597. OPEN grid.file$ FOR OUTPUT AS 1
  598. WRITE#1,last.r%,last.c%
  599. FOR r%=1 TO last.r%
  600. FOR c%=1 TO last.c%
  601. WRITE#1,grid$(r%,c%)
  602. NEXT c%,r%
  603. CLOSE 1
  604. st.done:
  605. WINDOW CLOSE 1
  606. RETURN
  607. save.vocab:
  608. WINDOW 1
  609. CLS
  610. PRINT "SAVE WORD LIST"
  611. vocab.file$=FILES$(0)
  612. IF vocab.file$=nu$ THEN sv.done
  613. OPEN vocab.file$ FOR OUTPUT AS 1
  614. FOR j%=1 TO wd.count%
  615. IF wd$(j%)=nu$ THEN skip.null
  616. PRINT#1,wd$(j%)
  617. skip.null:
  618. NEXT j%
  619. CLOSE#1
  620. sv.done:
  621. WINDOW CLOSE 1
  622. RETURN
  623. prt.pzl:
  624. GOSUB select.device
  625. CALL TEXTFONT(4)
  626. CALL TEXTSIZE(9)
  627. CALL TEXTFACE(1)
  628. FOR tr%=1 TO last.r%
  629. FOR tc%=1 TO last.c%
  630. PRINT#1, , grid$(tr%,tc%);
  631. NEXT tc%
  632. PRINT#1,
  633. NEXT tr%
  634. CLOSE 1
  635. CALL TEXTSIZE(12)
  636. CALL TEXTFONT(3)
  637. CALL TEXTFACE(0)
  638. RETURN
  639. prt.sol:
  640. GOSUB select.device
  641. CALL TEXTSIZE(9)
  642. CALL TEXTFONT(4)
  643. CALL TEXTFACE(1)
  644. PRINT#1, "The hidden words are: "
  645. PRINT #1, "Word (row:col:direction)"
  646. FOR j%=1 TO wd.count%
  647. IF wu%(j%)=not.used% THEN nxt.sol
  648. LET dir%=wu%(j%)\g.size%+1
  649. LET cell.num%=wu%(j%)-(dir%-1)*g.size%+1
  650. LET row%=(cell.num%-1)\last.c%+1
  651. LET col%=(cell.num%-1) MOD last.c%+1
  652. PRINT#1, USING "&(##:##:##)";wd$(j%),row%,col%,dir%
  653. nxt.sol:
  654. NEXT j%
  655. CLOSE 1
  656. CALL TEXTSIZE(12)
  657. CALL TEXTFONT(3)
  658. CALL TEXTFACE(0)
  659. RETURN
  660. select.device:
  661. WINDOW 1
  662. CLS
  663. PRINT "SELECT OUTPUT DEVICE"
  664. LET device%=1
  665. BUTTON 1,2,"SCREEN",(52,48)-(122,63),3
  666. BUTTON 2,1,"PRINTER",(52,80)-(122,95),3
  667. BUTTON 3,1,"CLIPBOARD",(52,112)-(142,127),3
  668. BUTTON 4,1,"OK",(52,156)-(122,183),1
  669. sd.loop:
  670. WHILE DIALOG(0)<>1
  671. WEND
  672. LET btn%=DIALOG(1)
  673. IF btn%=4 THEN dev.ok
  674. LET device%=btn%
  675. BUTTON btn%,2
  676. BUTTON btn% MOD 3+1,1
  677. BUTTON (btn%+1)MOD 3+1,1
  678. GOTO sd.loop
  679. dev.ok:
  680. WINDOW CLOSE 1
  681. IF device%=1 THEN WINDOW 2,,(w1.x%,w1.y%)-(w2.x2%,w2.y2%),3
  682. WIDTH dev$(device%),255,ZONE%
  683. OPEN dev$(device%) FOR OUTPUT AS 1
  684. RETURN
  685.  
  686.  
  687.  
  688.  
  689.  
  690.  
  691.  
  692.  
  693.  
  694.  
  695.  
  696.  
  697.  
  698.  
  699.  
  700.  
  701.  
  702.  
  703.  
  704.